home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happysrc / pcblock.c < prev    next >
Text File  |  1993-11-30  |  40KB  |  1,057 lines
  1. /*********************************************************************
  2.  *
  3.  *       *** HAPPy Pascal Compiler ***
  4.  *             program,block コンパイル処理
  5.  *
  6.  *                void programme(void)
  7.  *                void block(Set fsys,enum symbol fsy,ctp *fprocp)
  8.  *
  9.  *       Copyright (c) H.Asano 1992.
  10.  *
  11.  *********************************************************************/
  12.  
  13. #define  EXTERN extern
  14. #include <stdlib.h>
  15. #include <string.h>
  16. #include "pascomp.h"
  17. #include "pcpcd.h"
  18.  
  19. void block(Set,enum symbol,ctp*) ;
  20. static void body(Set,ctp*)  ;
  21. static void paramcopy(ctp*) ;
  22. static void statement(Set)  ;
  23. static void compoundstatement(Set)    ;
  24. static void ifstatement(Set)     ;
  25. static void whilestatement(Set)  ;
  26. static void repeatstatement(Set) ;
  27. static void forstatement(Set)    ;
  28. static void forident(attr*)      ;
  29. static void forexpres1(Set,attr); 
  30. static void forexpres2(Set,attr,enum symbol,int*,int*) ;
  31. static void fordostatement(Set,attr,enum symbol,int) ;
  32. static void assignment(Set,ctp*) ;
  33. static void casestatement(Set) ;
  34. static void withstatement(Set) ;
  35. static void gotostatement(Set) ;
  36. extern void call(Set,ctp*) ;
  37. extern void expression(Set) ;
  38. extern void selector(Set,ctp*) ;
  39. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  40. extern void enterid(ctp*) ;
  41. extern ctp  *searchid(Set);
  42. extern ctp  *searchsection(ctp*) ;
  43. extern void insymbol(void);
  44. extern void skip(Set) ;
  45. extern void updatelc(int)    ;
  46. extern void pcerr(int,char*) ;
  47. extern char *inttoch(long)   ;
  48. extern char *inttoch(long)   ;
  49. extern char *inttoch(long) ;
  50. extern Set  *mkset(Set*,int,...) ;
  51. extern Set  *orset(Set*,Set*)    ;
  52. extern Set  *dfset(Set*,Set*) ;
  53. extern int  crelabel(void) ;
  54. extern void labeldecl(Set);
  55. extern void constdecl(Set);
  56. extern void typedecl(Set);
  57. extern void vardecl(Set,ctp*);
  58. extern void procfuncdecl(Set,enum symbol,ctp**);
  59. extern void gencupent(enum pcdmnc, int, int) ;
  60. extern void genjump(enum pcdmnc,int) ;
  61. extern void putlabel(int) ;
  62. extern void genret(stp*) ;
  63. extern void putprogname(char*);
  64. extern void putlblv(int,int) ;
  65. extern void putq(void) ;
  66. extern void gen0(enum pcdmnc) ;
  67. extern void gen1(enum pcdmnc, int) ;
  68. extern void gen0t(enum pcdmnc,stp*) ;
  69. extern void gen1t(enum pcdmnc,stp*,int) ;
  70. extern void gen2t(enum pcdmnc,stp*,int,int) ;
  71. extern void genlca(void) ;
  72. extern void genlda(int,int) ;
  73. extern void genldc(char,long) ;
  74. extern void genchk(stp*,int,long,long) ;
  75. extern void convertint(stp*) ;
  76. extern void load(void) ;
  77. extern void loadaddress(void) ;
  78. extern void store(attr) ;
  79. extern void gencompare(enum pcdmnc,char,int) ;
  80. extern void checkbounds(stp*,int) ;
  81. extern boolean compatible(stp*,stp*) ;
  82. extern boolean assigncompati(stp*,stp*) ;
  83. extern int  align(stp*,int) ;
  84. extern void constant(Set,stp**,union valu*) ;
  85. extern void *Malloc(int)  ;
  86.  
  87. static int lcmax    ;
  88.  
  89.  
  90. /*******************************************************
  91.  *   programme() : program の 処理   
  92.  *     形式は、次の2通り
  93.  *        program ident( filename,filename,･･･ ) ;  
  94.  *        program ident;
  95.  *******************************************************/
  96. void programme(void)
  97. {
  98.   extfilep  *extfp ;                    /* ファイル名格納エリアのポインタ   */
  99.   Set       fsys   ;                    /* block で 最初に現れるsymbolの集合*/
  100.   Set       casesys;                    /* casesyだけの集合 (ワーク)        */
  101.   ctp       *cp    ;                    /* input,output名前登録用           */
  102.   int       i      ;
  103.   int       adr    ;
  104.   boolean   err196 ;
  105.  
  106.      fextfilep = nil ;
  107.  
  108.      if(sy == progsy) {
  109.       insymbol();
  110.       if(sy != ident) pcerr(2,"");      /* 名前がない                 */
  111.       putprogname(id) ;                 /* プログラム名の出力         */
  112.       insymbol();
  113.       if((sy != lparent) && (sy != semicolon))  
  114.        pcerr(14,"");                    /* ; がない                   */
  115.  
  116.       if(sy == lparent) {               /* プログラム引数の処理       */
  117.        do {
  118.         insymbol();
  119.         if(sy == ident) {
  120.           err196 = false    ;
  121.           extfp = fextfilep ;
  122.           while(extfp) {                /* 重複指定チェック           */
  123.            if(!strcmp(extfp->filename,id)) {
  124.             pcerr(196,id) ;             /* プログラム引数に同じ名前   */
  125.             err196 = true ;
  126.            } 
  127.            extfp = extfp->nextfile ;
  128.           }
  129.           if(!err196) {
  130.            if(!(i=strcmp(id,"input")) || !(strcmp(id,"output"))) {
  131.             if(i!=0) {                  /* outputの時                 */
  132.              adr = outputadr ;
  133.              defineoutput = true ;      /* outputファイル定義済       */
  134.             }
  135.             else {                      /* inputの時                  */
  136.              adr = inputadr ;
  137.              defineinput = true ;       /* inputファイル定義済        */
  138.             }
  139.             cp = mkctp(id,vars,textptr,nil) ;
  140.             cp->n.v.vkind = actual ;
  141.             cp->n.v.vlev  = level  ;
  142.             cp->n.v.vaddr = adr    ;
  143.             enterid(cp);
  144.            } 
  145.  
  146.            extfp = (extfilep*)Malloc(sizeof(extfilep)) ;
  147.            strcpy(extfp->filename,id);
  148.        extfp->nextfile = fextfilep ;
  149.            fextfilep = extfp ;
  150.           }
  151.  
  152.           insymbol() ;
  153.           if((sy != comma) && (sy != rparent))
  154.            pcerr(20,"") ;               /* , がない                   */
  155.         }
  156.     else pcerr(2,"") ;              /* 名前がない                 */
  157.        } while(sy == comma);
  158.        if(sy != rparent) pcerr(14,"");  /* ; がない                   */
  159.        insymbol();
  160.       }
  161.       if(sy!=semicolon) pcerr(14,"");   /* ; がない                   */
  162.       else insymbol();
  163.      }
  164.      else pcerr(3,"") ;                 /* program がない             */
  165.  
  166.      fsys = blockbegsys        ;        /* fsys =  blockbegsys        */
  167.      orset(&fsys,&statbegsys)  ;        /*       + statbegsys         */
  168.      mkset(&casesys,casesy,-1) ;
  169.      dfset(&fsys,&casesys)     ;        /*       - casesy             */  
  170.  
  171.      do {                               /* 誤り回復のためrepeat       */
  172.       block(fsys,period,nil) ;          /* block の コンパイル        */
  173.       if(sy != period) pcerr(21,"") ;   /*  *がない                   */
  174.      } while(sy != period)   ; 
  175.  
  176. }
  177.  
  178. /**************************************/
  179. /* block() : block の 翻訳            */
  180. /**************************************/
  181. void block(Set fsys,         /* blockに最初に現れるsymbolの集合    */
  182.            enum symbol fsy,  /* blockの終わりのsymbol              */ 
  183.            ctp *fprocp)      /* proc/funcの名前ポインタ(mainはnil) */
  184.            
  185. {
  186.   enum symbol lsy ;
  187.   Set bodyfsys    ;
  188.   ctp *pffwdptr = nil  ;                /* 手続き･関数の前方宣言リスト*/
  189.   ctp *lcp        ;
  190.   extfilep *extp  ;                     /* プログラム引数リスト       */
  191.  
  192.      do {                               /* declare partの処理         */
  193.       if(sy == labelsy) {
  194.        insymbol() ;
  195.        labeldecl(fsys) ;                /* label節の処理              */
  196.       }
  197.       if(sy == constsy) {
  198.        insymbol() ;
  199.        constdecl(fsys) ;                /* const節の処理              */
  200.       }
  201.       if(sy == typesy)  {
  202.        insymbol() ;
  203.        typedecl(fsys)  ;                /* type節の処理               */
  204.       }
  205.       if(sy == varsy)   {
  206.        insymbol() ;
  207.        vardecl(fsys,fprocp)   ;         /* var節の処理                */
  208.       } ;
  209.  
  210.       if(fprocp == nil) {               /* メインブロックの時         */
  211.        extp = fextfilep ;
  212.        while(extp) {                    /* プログラム引数の宣言チェック*/
  213.         strcpy(id,extp->filename) ;
  214.         lcp = searchsection(display[level].fname) ;
  215.         if(!lcp) pcerr(197,id) ;        /* プログラム引数が未宣言      */
  216.         extp = extp->nextfile  ;
  217.        }
  218.        
  219.        gen1(iMST,0) ;                   /*  mst命令の生成             */
  220.        mainlabel = crelabel()       ;   /*  メインブロックのラベル名  */
  221.        gencupent(iCUP,0,mainlabel ) ;   /*  cup命令の生成             */
  222.        gen0(iSTP)   ;                   /*  stp命令の生成             */
  223.  
  224.       }
  225.  
  226.       while((sy == procsy) || (sy == funcsy)) {
  227.        lsy = sy   ;
  228.        insymbol() ;
  229.        procfuncdecl(fsys,lsy,&pffwdptr) ;/* 手続き･関数の宣言処理     */
  230.       } ;
  231.       
  232.       while(pffwdptr) {                 /* 手続き･関数の前方宣言チェック*/
  233.        pcerr(118,pffwdptr->name) ;      /*  前方宣言の実体がない      */
  234.        pffwdptr = pffwdptr->n.pf.sd.d.af.a.fwdptr ;
  235.       }
  236.        
  237.       if(sy != beginsy) {
  238.        pcerr(18,"") ;                   /* 宣言部に誤りがある         */
  239.        skip(fsys) ;
  240.       } ;
  241.      
  242.      } while(! inset(statbegsys,sy)) ;  /* 誤り回復のため繰り返し     */
  243.      
  244.      if(sy == beginsy) insymbol()   ;
  245.      else              pcerr(17,"") ;   /* begin がない               */
  246.  
  247.      bodyfsys = fsys ;
  248.      addset(bodyfsys,casesy) ;
  249.      do {
  250.       body(bodyfsys,fprocp)     ;       /* begin ～ end の処理        */
  251.       if(sy != fsy) {
  252.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  253.        skip(fsys)  ;
  254.       }
  255.      } while((sy != fsy) && (! inset(blockbegsys,sy))) ;
  256. }
  257.  
  258. /**************************************/
  259. /* body() : body部 の 翻訳            */
  260. /**************************************/
  261. static void body(Set fsys,ctp *fprocp)
  262. {
  263.   lbp *llp     ;
  264.   int entname  ;
  265.   Set statementfsys ;
  266.   int stacktop ;
  267.   int segsize ;
  268.   boolean test ;
  269.  
  270.      topnew = topmax = lcaftermarkstack ;
  271.      entname = (!fprocp) ? mainlabel               /* mainのbodyの時       */
  272.                  : fprocp->n.pf.sd.d.af.a.pfname ; /* 手続き･関数のラベル値*/
  273.  
  274.      putlabel(entname)    ;             /* ラベルの出力               */
  275.      segsize = crelabel() ;
  276.      stacktop= crelabel() ;
  277.      gencupent(iENT,1,segsize) ;
  278.      gencupent(iENT,2,stacktop) ;
  279.  
  280.  
  281.      if(fprocp) paramcopy(fprocp) ;     /* 手続き･関数の時 仮引数を
  282.                                                スタックにコピーする   */
  283.      lcmax = lc ;
  284.  
  285.     /**** statement の 処理　****/
  286.  
  287.      statementfsys = fsys ;             /* statementfsys =            */
  288.      addset(statementfsys,semicolon);   /*  fsys + semicolon          */
  289.      addset(statementfsys,endsy)    ;   /*       + endsy              */
  290.      do {
  291.       do {
  292.        statement(statementfsys);
  293.       } while(inset(statbegsys,sy)) ;
  294.       if(test=(sy == semicolon)) insymbol() ;  /* ; ならば次のsymbolを読む */
  295.      } while(test) ;                           /* ; ならば繰り返す    */
  296.      if(sy == endsy) insymbol() ;
  297.      else pcerr(13,"") ;                /* end がない                 */
  298.  
  299.    /**** ラベルの定義チェック ****/
  300.  
  301.      llp = display[top].flabel;
  302.      while(llp) {                       /* 宣言られたラベルについて   */
  303.       if(!llp->defined)                 /*   未定義                   */
  304.        pcerr(168,inttoch((long)llp->labval)); /* ラベル未出現         */
  305.       llp = llp->nextlab ;
  306.      }
  307.  
  308.      if(fprocp) {                       /* 手続き･関数内のブロックの時*/
  309.       genret(fprocp->idtype) ;          /* 型に応じたret命令生成      */
  310.       if(fprocp->klass == func)         /* 関数の時                   */
  311.        if(!display[top].funcassign)     /*   関数名への代入がない時   */
  312.         pcerr(176,fprocp->name) ;       /*     関数名への代入がない   */
  313.      }   
  314.      else genret(nil)        ;          /* mainブロックの時はretp命令 */
  315.  
  316.      putlblv(segsize , lcmax ) ;               
  317.      putlblv(stacktop, topmax) ;
  318.      if(!fprocp) putq()  ;              /* mainブロックの時 q指令を出力*/
  319.      
  320. }
  321.  
  322. /**************************************/
  323. /* paramcopy() : 値引数のコピー処理   */
  324. /**************************************/
  325. static void paramcopy(ctp *fprocp)
  326. {
  327.   ctp *lcp ;
  328.   int llc ;
  329.  
  330.      llc = lcaftermarkstack ;
  331.      lcp = fprocp->next     ;           /* 引数の先頭                 */
  332.  
  333.      while(lcp) {
  334.       llc = align(parmptr,llc) ;        /* 境界調整                   */
  335.       if(lcp->klass == vars)            /* 変数の時                   */
  336.        if(lcp->idtype)
  337.         if(lcp->idtype->form > power) { /* 配列･レコード型            */
  338.          if(lcp->n.v.vkind == actual) { /* 値引数                     */
  339.           genlda(0,lcp->n.v.vaddr) ;    /* lda命令                    */
  340.           gen2t(iLOD,nilptr,0,llc) ;    /* lod命令                    */
  341.           gen2t(iMOV,nil,1,lcp->idtype->size); /* mov命令             */
  342.          }
  343.          llc += ptrsize ;
  344.         }
  345.         else llc += lcp->idtype->size ; /* スカラ､範囲､集合､ポインタ  */
  346.       lcp = lcp->next ;
  347.      }
  348. }
  349.  
  350. /**************************************/
  351. /* statement() : 文 の コンパイル     */
  352. /**************************************/
  353. static void statement(Set fsys)
  354. {
  355.   Set ws ;
  356.   Set statfolsys ;                      /* 文の後に続くsymbolの集合   */
  357.   Set identsys   ;                      /* 名前の集合                 */
  358.   ctp *lcp ;
  359.   lbp *llp ;
  360.  
  361.      mkset(&statfolsys, semicolon,endsy,elsesy,untilsy,-1);
  362.      mkset(&identsys,   vars,field,func,proc,-1) ;
  363.  
  364.   /**** label の 処理 ****/
  365.      if(sy == intconst) {
  366.       llp = display[level].flabel ;
  367.       while(llp) {
  368.        if(llp->labval == (int)val.ival) {  /* 宣言されたラベルの時    */
  369.         if(llp->defined)
  370.          pcerr(165,inttoch(val.ival));/* ラベルが再度宣言された       */
  371.         putlabel(llp->labname)     ;  /* ラベル値の出力               */
  372.         llp->defined = true        ;  /* 定義済                       */
  373.         break ;
  374.        }
  375.        else llp = llp->nextlab     ;    /* ラベル名が違う時           */
  376.       }
  377.       if(!llp)
  378.        pcerr(167,inttoch(val.ival));    /* ラベルが未宣言             */
  379.       insymbol() ;
  380.       if(sy == colon) insymbol()   ;
  381.       else pcerr(5,"")             ;    /* : がない　                 */
  382.      }
  383.  
  384.   /***********************/
  385.  
  386.      if((! inset(fsys,sy)) && (sy != ident)) {    /* 許されないsymbolの時 */
  387.       pcerr(6,"") ;                               /* 不当なsymbolが現れた */
  388.       skip(fsys)  ;
  389.      }
  390.      if((inset(fsys,sy)) || (sy == ident)) {      /* 文の最初としてOKの時 */
  391.       switch(sy) {
  392.        case ident :    lcp=searchid(identsys) ;
  393.                        insymbol() ;
  394.                        if(lcp->klass != proc)
  395.                         assignment(fsys,lcp) ;      /* 代入文の処理   */
  396.                        else if((lcp->klass == proc) &&
  397.                                (inset(statfolsys,sy) || (sy == lparent)))
  398.                         call(fsys,lcp) ;            /* 手続きのみ呼出 */
  399.                        else {           
  400.                         pcerr(6,"") ;   /* 不当な記号が現れた         */
  401.                         ws = fsys ;
  402.                         orset(&ws,&statfolsys) ;
  403.                         skip(ws)  ;     /* 読み飛ばし                 */
  404.                        }
  405.                        break ; 
  406.        case beginsy  : insymbol() ;
  407.                        compoundstatement(fsys) ;
  408.                        break ;
  409.        case gotosy   : insymbol() ;
  410.                        gotostatement(fsys) ;
  411.                        break ;
  412.        case ifsy     : insymbol() ;
  413.                        ifstatement(fsys) ;
  414.                        break ;
  415.        case casesy   : insymbol() ;
  416.                        casestatement(fsys) ;
  417.                        break ;
  418.        case whilesy  : insymbol() ;
  419.                        whilestatement(fsys) ;
  420.                        break ;
  421.        case repeatsy : insymbol() ;
  422.                        repeatstatement(fsys) ;
  423.                        break ;
  424.        case forsy    : insymbol() ;
  425.                        forstatement(fsys) ;
  426.                        break ;
  427.        case withsy   : insymbol() ;
  428.                        withstatement(fsys) ;
  429.       }
  430.  
  431.       if(! inset(statfolsys,sy)) {
  432.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  433.        skip(fsys) ;
  434.       }
  435.      }
  436. }
  437.  
  438. /***************************************/
  439. /* compoundstatement() : begin文の処理 */
  440. /***************************************/
  441. static void compoundstatement(Set fsys)
  442. {
  443.   Set ws;
  444.   boolean test;
  445.  
  446.      do {
  447.       do {
  448.        mkset(&ws,semicolon,endsy,-1);
  449.        orset(&ws,&fsys) ;
  450.        statement(ws) ;
  451.       } while(inset(statbegsys,sy)) ; /* statement以外がでてきた時終わり*/
  452.       if(test = (sy == semicolon)) insymbol() ; /* ; ならば次のsymbol */
  453.      } while(test) ;                    /* ; ならば繰り返す           */
  454.      
  455.      if(sy == endsy) insymbol() ;       /* end ならば次のsymbol       */
  456.      else pcerr(13,"") ;                /*  end がない                */
  457. }
  458.  
  459. /***************************************/
  460. /*   gotostatement() : goto文の処理    */
  461. /***************************************/
  462. static void gotostatement(Set fsys)
  463. {
  464.   lbp *llp ;
  465.   int ttop,ttop1 ;
  466.   boolean found ;
  467.  
  468.      if(sy == intconst) {               /* ラベルは整数               */
  469.       found = false ;
  470.       ttop  = top   ;
  471.       while(display[ttop].occur != blck) 
  472.         ttop-- ;                        /* block水準を探す            */
  473.       ttop1 = ttop ;
  474.       do {
  475.        llp = display[ttop].flabel ;
  476.        while(llp) {
  477.         if(llp->labval == (int)val.ival) { /* ラベル値が同じ          */
  478.          found = true ;
  479.          if(ttop == ttop1)              /* ラベルの定義水準と同じ     */
  480.           genjump(iUJP,llp->labname) ;  /* ujp命令                    */
  481.          else
  482.           gencupent(iEJP,level-ttop,llp->labname); /* ejp命令         */
  483.          break ;                        /* whileループを抜ける        */
  484.         }
  485.         else llp = llp->nextlab ;
  486.        }
  487.        ttop-- ;
  488.       } while((! found) && (ttop != 0)) ;
  489.       if(! found)
  490.        pcerr(167,inttoch(val.ival));    /* ラベルが未宣言             */
  491.       insymbol() ;
  492.      }
  493.      else pcerr(164,"") ;               /* ラベルが整数でない         */
  494. }
  495.  
  496. /***************************************/
  497. /*    ifstatement() : if文の処理       */
  498. /***************************************/
  499. static void ifstatement(Set fsys)
  500. {
  501.   int lcix1,lcix2 ;
  502.   Set ws ;
  503.  
  504.      ws = fsys ;
  505.      addset(ws,thensy) ;
  506.      expression(ws) ;                   /* ifの次の式を評価           */
  507.      load()               ;             /* 式の値をloadする           */
  508.      if(gattr.typtr)
  509.       if(gattr.typtr != boolptr)        /* 式の値がbooleanでない時    */
  510.        pcerr(146,"if文")  ;             /*  演算対象は論理型でないと駄目*/
  511.      lcix1 = crelabel()   ;
  512.      genjump(iFJP,lcix1)  ;             /* 偽ならelseまたはifの終わりに飛ぶ*/
  513.  
  514.      if(sy == thensy) insymbol() ;
  515.      else pcerr(52,"")    ;             /* then がない                */
  516.  
  517.      ws = fsys ;
  518.      addset(ws,elsesy)    ;
  519.      statement(ws)        ;             /* thenの次の文を処理         */
  520.  
  521.      if(sy == elsesy) {
  522.       lcix2 = crelabel()  ;
  523.       genjump(iUJP,lcix2) ;             /* elseの終わりまで飛ぶ       */
  524.       putlabel(lcix1)     ;             /* elseのラベル出力           */
  525.       insymbol()          ;
  526.       statement(fsys)     ;             /* elseの次の文を処理         */
  527.       putlabel(lcix2)     ;             /* elseの終わりのラベル出力   */
  528.      }
  529.      else putlabel(lcix1) ;             /* elseがない時 if文の終わりのラベル*/
  530. }
  531.  
  532. /***************************************/
  533. /*  whilestatement() : while文の処理   */
  534. /***************************************/
  535. static void whilestatement(Set fsys)
  536. {
  537.   int laddr ;                           /* 戻りラベル値               */
  538.   int lcix  ;                           /* 飛び越しラベル値           */
  539.   Set ws    ;
  540.   
  541.      laddr = crelabel() ;               /* ラベル値を得る             */
  542.      putlabel(laddr)    ;               /* ラベル値の出力             */
  543.  
  544.      ws = fsys ;
  545.      addset(ws,dosy)    ;
  546.      expression(ws)     ;               /* whileの次の式の評価        */
  547.      load()             ;               /* 式の値をloadする           */
  548.      if(gattr.typtr) 
  549.       if(gattr.typtr != boolptr)        /* 式の値がbooleanでない時    */
  550.        pcerr(146,"while文")  ;          /*  演算対象は論理型でないと駄目*/
  551.      lcix = crelabel()  ;               /* 飛び越しラベル値を得る     */
  552.      genjump(iFJP,lcix) ;               /* fjp命令の生成              */
  553.      if(sy == dosy) insymbol() ;
  554.      else pcerr(54,"")  ;               /* do がない                  */
  555.  
  556.      statement(fsys)    ;               /* 文の処理                   */
  557.  
  558.      genjump(iUJP,laddr);               /* ujp命令でwhile文の先頭に戻る*/
  559.  
  560.      putlabel(lcix)     ;               /* 飛び先ラベルの出力         */
  561. }
  562.  
  563. /*****************************************/
  564. /*  repeatstatement() : repeat文の処理   */
  565. /*****************************************/
  566. static void repeatstatement(Set fsys)
  567. {
  568.   int laddr ;                           /* 戻りラベル値               */
  569.   Set ws    ;
  570.   boolean test ;
  571.  
  572.      laddr = crelabel() ;               /* ラベル値を得る             */
  573.      putlabel(laddr)    ;               /* ラベル値の出力             */
  574.  
  575.      mkset(&ws,semicolon,untilsy,-1);
  576.      orset(&ws, &fsys) ;
  577.      do {
  578.       do {
  579.        statement(ws)   ;                 /* 文の処理                   */
  580.        if(inset(statbegsys,sy))
  581.         pcerr(14,"") ;                   /*  ; がない                  */
  582.       } while(inset(statbegsys,sy)); /*  文として正しいsymbolならﾘﾋﾟｰﾄ */
  583.       if(test = (sy==semicolon)) insymbol() ; /* ; ならば次のsymbol    */
  584.      } while(test) ;                     /*      ; ならば繰り返す      */
  585.      
  586.      if(sy == untilsy) {
  587.       insymbol() ;
  588.       expression(fsys) ;                /* untilに続く式の評価        */
  589.       load()             ;              /* 式の値をloadする           */
  590.       if(gattr.typtr)
  591.        if(gattr.typtr != boolptr)       /* 式の値がbooleanでない時    */
  592.         pcerr(146,"repeat文") ;         /*  式は論理式でない          */
  593.       genjump(iFJP,laddr) ;             /* fjp命令の生成              */
  594.      }
  595.      else pcerr(53,"") ;                /* until がない               */
  596. }
  597.  
  598. /***************************************/
  599. /* forstatement() : for文のコンパイル  */
  600. /***************************************/
  601. static void forstatement(Set fsys)
  602. {
  603.   attr lattr ;
  604.   int  llc   ;
  605.   enum symbol lsy ;
  606.   int  looplabel  ;                     /* for文のループ用ラベル値    */
  607.   int  forendlabel;                     /* for文終了の飛び先ラベル値  */
  608.   Set  ws    ;
  609.  
  610.      llc = lc ;                         /* 変数割りつけ状況を退避     */
  611.      lattr.typtr  = nil   ;             /* 制御変数の属性初期設定     */
  612.      lattr.kind   = varbl ;
  613.      lattr.access = drct  ;
  614.      lattr.vlevel = level ;
  615.      lattr.dplmt  = 0     ;
  616.      
  617.      if(sy == ident) forident(&lattr) ;
  618.      else {
  619.       pcerr(2,"") ;                     /* 名前がない                 */
  620.       mkset(&ws,becomes,tosy,downtosy,dosy,-1) ;
  621.       orset(&ws,&fsys) ;
  622.       skip(ws)    ;                     /*     読み飛ばし             */
  623.      }
  624.  
  625.      if(sy == becomes) forexpres1(fsys,lattr) ;  /* 式1の処理         */
  626.      else {
  627.       pcerr(51,"") ;                    /* := がない                  */
  628.       mkset(&ws,tosy,downtosy,dosy,-1) ;
  629.       orset(&ws,&fsys) ;
  630.       skip(ws)     ;                    /*     読み飛ばし             */
  631.      }
  632.  
  633.      if((sy == tosy) || (sy == downtosy)) {
  634.       lsy = sy     ;                    /* to か downsyを後で判断するため退避*/
  635.       forexpres2(fsys,lattr,lsy,&looplabel,&forendlabel) ; /* 式2の処理      */
  636.      } 
  637.      else {
  638.       pcerr(55,"") ;                    /* to / downto がない         */
  639.       mkset(&ws,dosy,-1) ;
  640.       orset(&ws,&fsys)   ;
  641.       skip(ws)           ;              /*     読み飛ばし             */
  642.      }
  643.      
  644.      if(sy == dosy) insymbol() ;
  645.      else pcerr(54,"")   ;              /* do がない                  */
  646.  
  647.      fordostatement(fsys,lattr,lsy,looplabel) ;    /* doに続く文の処理*/
  648.  
  649.      putlabel(forendlabel) ;            /* for文の終わりラベル出力    */
  650.      
  651.      lc = llc              ;            /* 一時変数を開放             */
  652. }
  653.  
  654. /***************************************/
  655. /* forident() : for文の制御変数処理    */
  656. /***************************************/
  657. static void forident(attr *fattr)
  658. {
  659.   ctp *lcp ;
  660.   Set ws   ;
  661.   int ltop ;
  662.  
  663.      mkset(&ws,vars,-1) ;
  664.      lcp = searchid(ws) ;               /* 変数の中から名前を探す     */
  665.  
  666.      (*fattr).typtr = lcp->idtype ;     /*   変数の型                 */
  667.      (*fattr).kind  = varbl       ;
  668.      if(lcp->n.v.vkind == actual) {     /* 実変数ならばOK             */
  669.       (*fattr).access = drct ;
  670.       (*fattr).vlevel = lcp->n.v.vlev ; /*    変数の宣言レベル        */
  671.       (*fattr).dplmt  = lcp->n.v.vaddr; /*    変数の割りつけアドレス  */
  672.       ltop = top ;
  673.       while(display[ltop].occur != blck) /* block水準を探す           */
  674.        ltop-- ;
  675.       if(lcp->n.v.vlev != ltop)         /* 制御変数の定義水準が       */
  676.        pcerr(186,id) ;                  /*  for文と同一ぶろっくでない */ 
  677.      }
  678.      else {
  679.       pcerr(187,id) ;                   /* 変数引数を制御変数に使えない */
  680.       (*fattr).typtr = nil ;
  681.      }
  682.  
  683.      if((*fattr).typtr)
  684.       if(((*fattr).typtr->form > subrange) ||     /* ポインタ型､集合型､   */
  685.                                                   /* レコード型､ファイル型*/
  686.          (realptr == (*fattr).typtr)) {           /* またはreal型         */
  687.        pcerr(188,id) ;                            /* 制御変数の型が不当   */
  688.        (*fattr).typtr = nil ;
  689.       }
  690.  
  691.      insymbol() ;
  692. }
  693.  
  694. /***************************************/
  695. /* forexpres1() : for文の式1処理       */
  696. /*      for 制御変数:=式1 ････         */
  697. /***************************************/
  698. static void forexpres1(Set fsys,attr fattr)
  699. {
  700.   Set ws ;
  701.    
  702.      insymbol() ;
  703.  
  704.      mkset(&ws,tosy,downtosy,dosy,-1) ;
  705.      orset(&ws,&fsys) ;
  706.      expression(ws)   ;                 /* 式1を評価                  */
  707.  
  708.      if(gattr.typtr)
  709.       if((gattr.typtr->form != scalar) || (gattr.typtr == realptr))
  710.        pcerr(144,"for文の初期値")  ;/* 式が順序式でない               */
  711.       else if(compatible(fattr.typtr,gattr.typtr)) {   /* 制御変数と型が同じ*/
  712.        load() ;                         /* 式の値をload               */
  713.        store(fattr) ;                   /* 制御変数域にstore          */
  714.       }
  715.       else pcerr(145,"初期値") ;        /* 制御変数と初期値の型が不適合*/
  716. }       
  717.  
  718. /****************************************/
  719. /* forexpres2() : for文の式2処理        */
  720. /*   for ･･･ to/downto 式2 do ･･･       */
  721. /****************************************/
  722. static void forexpres2(Set fsys,attr fattr,
  723.                        enum symbol fsy,int *flooplabel,int *forendlabel)
  724. {
  725.   stp  *lspfin ;
  726.   char typind  ;                        /* gencompareに引き渡す型文字 */
  727.   int  tempadr ;                        /* 一時変数域のアドレス       */
  728.   Set ws ;
  729.  
  730.      insymbol() ;
  731.  
  732.      ws = fsys ;
  733.      addset(ws,dosy) ;
  734.      expression(ws) ;                   /* 式2を評価                  */
  735.  
  736.      lspfin = gattr.typtr ;             /* 終値の属性を退避           */
  737.      if(lspfin == boolptr)      typind = 'b' ;    /* boolean          */
  738.      else if(lspfin == charptr) typind = 'c' ;    /* char             */
  739.      else                       typind = 'i' ;    /* integer/列挙型   */
  740.  
  741.      if(lspfin)
  742.       if((lspfin->form != scalar) || (lspfin == realptr))
  743.        pcerr(144,"for文の終値")  ;          /* 順序式でない           */
  744.       else if(compatible(fattr.typtr,lspfin)) {  /* 制御変数と型が同じ*/
  745.        load() ;                             /* 式の値をload           */
  746.        updatelc(align(lspfin,lc) - lc) ;    /* 境界合わせ             */
  747.        tempadr = lc ;
  748.        gen2t(iSTR,lspfin,0,tempadr) ;       /* 一時変数域に式の値をstr*/
  749.        *flooplabel = crelabel() ;
  750.        if(!debug)                            /* debugでないならば      */
  751.         putlabel(*flooplabel) ;              /* ループラベル出力       */
  752.        gattr = fattr  ;
  753.        load()          ;                     /* 制御変数をload         */
  754.        gen2t(iLOD,lspfin,0,tempadr) ;        /* 一時変数(式2)をload    */
  755.        updatelc(lspfin->size)       ;
  756.        if(lc > lcmax) lcmax =lc ;            /* 最大変数域サイズの更新 */
  757.        (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならeq命令生成 */
  758.                      : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */ 
  759.       }
  760.       else pcerr(145,"終値") ;          /* 制御変数と終値の型が不適合  */
  761.  
  762.      *forendlabel = crelabel() ;        /* for文終了後の飛び先ラベル生成*/
  763.      genjump(iFJP,*forendlabel);        /* fjp命令生成                */
  764.  
  765.      if(debug) {                        /* debugの時                  */
  766.       gattr = fattr   ;
  767.       load()          ;                 /* 制御変数をload             */
  768.       checkbounds(fattr.typtr,52);      /* 範囲チェック               */
  769.       store(fattr) ;
  770.       gen2t(iLOD,lspfin,0,tempadr)  ;   /* 一時変数(式2)をload        */
  771.       checkbounds(fattr.typtr,53)   ;   /* 範囲チェック               */
  772.       gen2t(iSTR,lspfin,0,tempadr) ;    /* 一時変数域に式の値をstr    */
  773.       
  774.       putlabel(*flooplabel) ;           /* ループラベル出力           */
  775.       gattr = fattr   ;
  776.       load()          ;                 /* 制御変数をload             */
  777.       gen2t(iLOD,lspfin,0,tempadr)  ;   /* 一時変数(式2)をload        */
  778.       (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならleq命令生成 */
  779.                     : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */ 
  780.       genjump(iFJP,*forendlabel);       /* fjp命令生成                */
  781.      }
  782. }
  783.  
  784. /**********************************************/
  785. /* fordostatement() : for文のdoに続く文の処理 */
  786. /*                     for ･･･  do 文         */
  787. /**********************************************/
  788. static void fordostatement(Set fsys,attr fattr,
  789.                            enum symbol fsy,int looplabel)
  790. {
  791.      statement(fsys) ;                  /* 文の処理                   */
  792.  
  793.      gattr = fattr  ;
  794.      load()          ;                  /* 制御変数をload             */
  795.      (fsy == tosy) ? gen1t(iINC,gattr.typtr,1)    /* doなら    inc 1  */
  796.                    : gen1t(iDEC,gattr.typtr,1) ;  /* downtoならdec 1  */
  797.      store(fattr) ;
  798.      genjump(iUJP,looplabel) ;          /* ujp命令で戻る              */
  799. }
  800.  
  801. /*****************************************/
  802. /* withstatement() : with文のコンパイル  */
  803. /*****************************************/
  804. static void withstatement(Set fsys)
  805. {
  806.   ctp *lcp     ;
  807.   int oldlc    ;                         /* lcの退避域                */
  808.   int oldtop   ;                         /* display top の退避域      */
  809.   boolean test ;
  810.   Set ws       ;
  811.  
  812.      oldtop = top ;                     /* 今のdisplayのtopを退避     */
  813.      oldlc  = lc  ;                     /* 今のlcを退避               */
  814.  
  815.      do {
  816.       if(sy == ident) {
  817.        mkset(&ws,vars,field,-1) ;
  818.        lcp = searchid(ws) ;             /* 名前を変数､フィールド名より探す*/
  819.        insymbol() ;
  820.       }
  821.       else {
  822.        pcerr(2,"") ;                    /* 名前がない                 */
  823.        lcp = uvarptr ;                  /* 未定義用の変数ポインタ     */
  824.       }
  825.       mkset(&ws,comma,dosy,-1) ;
  826.       orset(&ws,&fsys) ;
  827.       selector(ws,lcp) ;                /* 変数の処理                 */
  828.       if(gattr.typtr)
  829.        if(gattr.typtr->form == records) 
  830.         if(top < Displimit) {           /* displayがまだある時        */
  831.          top++ ;
  832.          display[top].fname  = gattr.typtr->sf.re.fstfld ; /* 最初の欄*/
  833.          display[top].flabel = nil ;    /* ラベル欄の初期設定         */
  834.          if(gattr.access == drct) {     /* 直接参照の時               */
  835.           display[top].occur = crec ;   /* 固定部のレコード欄         */
  836.           display[top].clev  = gattr.vlevel ; /* 定義水準             */
  837.           display[top].cdspl = gattr.dplmt  ; /* 相対アドレス         */
  838.          }
  839.          else {                         /* 間接参照の時               */
  840.           loadaddress() ;               /* loadaddress命令            */
  841.           updatelc(align(nilptr,lc)-lc);/* lcの境界調整               */
  842.           gen2t(iSTR,nilptr,0,lc) ;     /* str命令                    */
  843.           display[top].occur = vrec ;   /* 可変レコード欄             */
  844.           display[top].vdspl = lc   ;   /* loadaddress 格納場所       */
  845.           updatelc(ptrsize)         ;   /* lcを1アドレス分進める      */
  846.           if(lc > lcmax) lcmax = lc ;
  847.          }
  848.         }
  849.         else
  850.          pcerr(603,inttoch((long)Displimit));/* 名前の入れ子が深すぎる */
  851.        else pcerr(140,"")  ;            /* 変数の型がレコードでない   */
  852.       if(test = (sy == comma)) insymbol() ; /* , なら次の変数を読む   */
  853.      } while(test) ;                    /* , なら次の変数の処理へ　   */
  854.  
  855.      if(sy == dosy) insymbol() ;
  856.      else pcerr(54,"") ;                /* do がない                  */
  857.  
  858.      statement(fsys)   ;                /* with文配下の文の処理       */
  859.  
  860.      top = oldtop ;                     /* 水準を元に戻す             */
  861.      lc  = oldlc  ;                     /* lcを元に戻す               */
  862. }
  863.  
  864. /**************************************/
  865. /* assignment() : 代入文のコンパイル  */
  866. /**************************************/
  867. static void assignment(Set fsys,ctp *fcp)
  868. {
  869.   attr lattr ;                          /* 1つ前の属性                */
  870.   Set ws ;
  871.  
  872.      ws = fsys ;
  873.      addset(ws,becomes)    ;
  874.      selector(ws, fcp)     ;            /* 左辺の処理                 */
  875.  
  876.      if(fcp->klass == func)             /* 左辺が関数の時             */
  877.       if(fcp->n.pf.pfdeckind == standard) {
  878.        pcerr(150,fcp->name) ;           /* 標準関数への代入は駄目     */
  879.        gattr.typtr = nil ;
  880.       }
  881.       else if(fcp->n.pf.sd.d.pfkind == formal)
  882.         pcerr(151,"") ;                 /* 関数引数への代入は駄目     */
  883.       else if(display[fcp->n.pf.sd.d.pflev+1].funcname != fcp)      
  884.        pcerr(177,fcp->name) ;           /* ここでは代入できない       */
  885.       else display[fcp->n.pf.sd.d.pflev+1].funcassign = true ;
  886.                                         /* 関数名への代入あり         */
  887.  
  888.      if(sy == becomes) {
  889.       if(gattr.typtr) 
  890.        if((gattr.access != drct) ||     /* 直接参照でないか            */
  891.           (gattr.typtr->form > power))  /* 配列型､レコード型､ファイル型*/
  892.         loadaddress() ;                 /* の時は、アドレスをのせる   */
  893.       lattr = gattr   ;                 /* 今の属性を退避しておく     */
  894.       insymbol() ;
  895.       expression(fsys) ;                /* 右辺の処理                 */
  896.       if(gattr.typtr)
  897.        if(gattr.typtr->form <= power)   /* スカラー､範囲､ポインタ､集合*/
  898.         load() ;
  899.        else loadaddress() ;
  900.  
  901.       if((lattr.typtr) && (gattr.typtr)) {
  902.        if((lattr.typtr == realptr) &&          /* 左辺が実数型で        */
  903.           (compatible(gattr.typtr,intptr))) {  /* 右辺が整数型の時      */
  904.         gen0(iFLT) ;                           /* 実数に変換 flt命令    */
  905.         gattr.typtr = realptr ;
  906.        }
  907.  
  908.        if(assigncompati(lattr.typtr,gattr.typtr)) /* 代入可能な時     */
  909.         switch(lattr.typtr->form) {           /* 型によって振り分ける */
  910.          case scalar   :
  911.          case subrange :
  912.            checkbounds(lattr.typtr,49) ;       /* 上限･下限のチェック */ 
  913.            store(lattr) ;
  914.            break ;
  915.          case pointer  :
  916.            store(lattr) ;
  917.            break ;
  918.          case power :
  919.            checkbounds(lattr.typtr,50) ;       /* 上限･下限のチェック */
  920.            store(lattr) ;
  921.            break ;
  922.          case arrays  :
  923.          case records :
  924.            gen2t(iMOV,nil,1,lattr.typtr->size) ;
  925.         }
  926.        else pcerr(129,"") ;             /* 代入可能でない　           */
  927.       }
  928.      }
  929.      else pcerr(51,"") ;                /*  := がない                 */
  930. }
  931.  
  932. /*****************************************/
  933. /* casestatement() : case文のコンパイル  */
  934. /*****************************************/
  935. typedef struct caseinfo cip ;
  936. struct caseinfo {
  937.    cip  *next   ;
  938.    int  csstart ;                       /* P-codeラベル値             */ 
  939.    long cslab   ;                       /* 定数値                     */
  940. } ;
  941.  
  942. static void casestatement(Set fsys)
  943. {
  944.   stp *lsp,*lsp1 ;
  945.   cip *lpt,*lpt1,*lpt2,*lpt3,*fstptr;
  946.   int laddr ;
  947.   int lcix,lcix1;
  948.   long lmin,lmax;
  949.   union valu lval ;
  950.   boolean test ;
  951.   Set ws ;
  952.  
  953.      mkset(&ws,ofsy,comma,colon,-1) ;
  954.      expression(ws) ;                   /* caseに続く式の処理         */
  955.      load() ;                           /* 式の値をload               */
  956.      lsp = gattr.typtr ;
  957.      if(lsp)
  958.       if((lsp->form != scalar) || (lsp == realptr)) {
  959.        pcerr(144,"case文の選択式") ;    /* 順序式でない               */
  960.        lsp = nil     ;
  961.       }
  962.       else
  963.        convertint(gattr.typtr) ;        /* 必要ならord命令生成        */
  964.  
  965.      lcix = crelabel() ;
  966.      genjump(iUJP,lcix) ;               /* 式の値チェックへ飛ぶ       */
  967.  
  968.      if(sy == ofsy) insymbol() ;
  969.      else pcerr(8,"")          ;        /* of がない                  */
  970.  
  971.      fstptr = nil ;
  972.      laddr = crelabel() ;
  973.      do {
  974.       lpt = nil ;
  975.       lcix1 = crelabel() ;
  976.       mkset(&ws,endsy,semicolon,-1);
  977.       if(! inset(ws,sy)) {              /* ; end でなければ           */
  978.        do {
  979.         mkset(&ws,comma,colon,-1);
  980.         orset(&ws,&fsys) ;
  981.         constant(ws,&lsp1,&lval) ;      /* 定数の処理                 */
  982.         if(lsp1)
  983.          if(lsp == lsp1) {              /* 式の型と定数の型を比較     */
  984.           lpt1 = fstptr ;
  985.           lpt2 = nil    ;
  986.           while(lpt1) {
  987.            if(lpt1->cslab <= lval.ival) {
  988.             if(lpt1->cslab == lval.ival)/* 前の定数と同じ値の時        */
  989.              pcerr(156,"") ;            /* case文の名札が再度定義された*/
  990.             break ;
  991.            }
  992.            lpt2 = lpt1;
  993.            lpt1 = lpt1->next ;
  994.           }
  995.           lpt = (cip*)Malloc(sizeof(cip)) ;
  996.           lpt->next = lpt1;
  997.           lpt->cslab = lval.ival ;
  998.           lpt->csstart = lcix1;
  999.           if(!lpt2) fstptr = lpt;
  1000.           else lpt2->next = lpt;
  1001.          }
  1002.          else pcerr(147,"") ;           /* case文の名札の型がおかしい */
  1003.         if(test=(sy==comma)) insymbol() ; /* , ならば次の定数を読む   */
  1004.        } while(test) ;                  /*   , ならば次の定数の処理   */
  1005.        if(sy == colon) insymbol() ;
  1006.        else pcerr(5,"") ;               /* : がない                   */
  1007.        putlabel(lcix1) ;
  1008.        ws = fsys;
  1009.        addset(ws,semicolon) ;
  1010.        lpt3 = lpt;                      /* QuickCのバグのため(lpt破壊)*/
  1011.        do {                             /* 誤り回復のため繰り返し     */
  1012.         statement(ws)       ;           /* 定数に対する文の処理       */
  1013.        } while(inset(statbegsys,sy));
  1014.        if(lpt3) genjump(iUJP,laddr);
  1015.       }
  1016.       if(test=(sy==semicolon)) insymbol() ;/* ; ならば次の定数を読む  */
  1017.      } while(test) ;                    /*    ; ならば次の定数の処理  */
  1018.  
  1019.      putlabel(lcix) ;
  1020.  
  1021.      if(fstptr) {                       /* reverse pointer            */
  1022.       lmax = fstptr->cslab ;
  1023.       lpt1 = fstptr ;
  1024.       fstptr = nil  ;
  1025.       do {
  1026.        lpt2 = lpt1->next ;
  1027.        lpt1->next = fstptr;
  1028.        fstptr = lpt1;
  1029.        lpt1 = lpt2 ;
  1030.       } while(lpt1) ;
  1031.       lmin = fstptr->cslab;
  1032.       if(lmax - lmin < Cixmax) {
  1033.        genchk(intptr,51,lmin,lmax);
  1034.        genldc('i',lmin);
  1035.        gen0(iSBI) ;
  1036.        lcix = crelabel() ;
  1037.        genjump(iXJP,lcix) ;
  1038.        putlabel(lcix);
  1039.        do {
  1040.         while(fstptr->cslab > lmin) {
  1041.          gen0(iUJC) ;
  1042.          lmin++ ;
  1043.         }
  1044.         genjump(iUJP,fstptr->csstart);
  1045.         fstptr = fstptr->next ;
  1046.         lmin++ ;
  1047.        } while(fstptr) ;
  1048.        putlabel(laddr) ;
  1049.       }
  1050.       else
  1051.        pcerr(601,inttoch((long)Cixmax)) ; /* case文の選択の範囲が大きすぎる*/
  1052.      }
  1053.  
  1054.      if(sy == endsy) insymbol() ;
  1055.      else pcerr(13,"") ;                /* end がない                 */
  1056. }
  1057.